Libraries

library(httr)
library(lubridate)
library(ggplot2)
library(ggrepel)
library(patchwork)
library(data.table)
library(broom)
library(rgdal)
require(maptools)
require(rgeos)

options(scipen=2)

Load and process map and current data

# Download the shape file from the web and unzip it:
# download.file("http://thematicmapping.org/downloads/TM_WORLD_BORDERS_SIMPL-0.3.zip", destfile="~/shape_files/world_shape_file.zip")
# system("unzip ~/shape_files/world_shape_file.zip")
world_spdf <- readOGR(dsn='~/shape_files/world_shape_file', layer='TM_WORLD_BORDERS_SIMPL-0.3')
## OGR data source with driver: ESRI Shapefile 
## Source: "C:\Users\jack_\Documents\shape_files\world_shape_file", layer: "TM_WORLD_BORDERS_SIMPL-0.3"
## with 246 features
## It has 11 fields
## Integer64 fields read as strings:  POP2005
tf <- "~/covid19.csv"
GET("https://opendata.ecdc.europa.eu/covid19/casedistribution/csv", authenticate(":", ":", type="ntlm"), write_disk(tf, overwrite = TRUE))
## Response [https://opendata.ecdc.europa.eu/covid19/casedistribution/csv/]
##   Date: 2020-10-23 22:03
##   Status: 200
##   Content-Type: application/octet-stream
##   Size: 3.51 MB
## <ON DISK>  C:\Users\jack_\Documents\covid19.csv
DT <- fread(tf)
setnames(DT, c('dateRep', 'day', 'month', 'year', 'new_Cases', 'new_Deaths', 'Country', 'geoId', 'countryCode', 'population', 'continent', 'roll_norm_Cases'))
DT[, Date := dmy(dateRep)]
# Dataframe-ize.
world_df <- as.data.table(tidy(world_spdf, region="ISO3"))
## SpP is invalid
# For plottting, the order of rows is super important. 
# Merge operations later can change the order, so I need to be able to recover it.
world_df[, ord := 1:nrow(world_df)]

# Sort newest last.
setorder(DT, Country, year, month, day)

# Total Cases and Deaths
DT[, total_Cases := cumsum(new_Cases), by=Country]
DT[, total_Deaths := cumsum(new_Deaths), by=Country]
DT[, Mortality := total_Deaths / total_Cases, by=Country]

# Sliding window cumulative cases in a W-days window.
W <- 7
DT[, roll_Cases := frollsum(new_Cases, n=W, align='right'), by=Country]
DT[, roll_Deaths := frollsum(new_Deaths, n=W, align='right'), by=Country]

# Remove all lines with no info
#DT <- DT[total_Cases > 0,]


# Day relative to first reported case
DT[, Day := 1:length(.SD$new_Cases), by=Country]

# Day relative to N deaths
N <- 100
DT[, Nplus := abs(total_Deaths - N)]
DT[, Day_Aligned := Day - .SD[Nplus==min(Nplus), Day][1], by=Country]
DT[, Nplus := NULL]

# Day relative to today
DT[, past_Days := Day - max(Day), by=Country]

# Population normalisations to P citizens
P <- 1e6
DT[, norm_new_Cases := new_Cases / population * P, by=Country]
DT[, norm_new_Deaths := new_Deaths / population * P, by=Country]
DT[, norm_tot_Cases := total_Cases / population * P, by=Country]
DT[, norm_tot_Deaths := total_Deaths / population * P, by=Country]
DT[, norm_roll_Cases := roll_Cases / population * P, by=Country]
DT[, norm_roll_Deaths := roll_Deaths / population * P, by=Country]

# Global
DT[, gNew_Cases := sum(new_Cases, na.rm=TRUE), by=Date]
DT[, gNew_Deaths := sum(new_Deaths, na.rm=TRUE), by=Date]
DT[, gTotal_Cases := sum(total_Cases, na.rm=TRUE), by=Date]
DT[, gTotal_Deaths := sum(total_Deaths, na.rm=TRUE), by=Date]
DT[, gRoll_Cases := sum(roll_Cases, na.rm=TRUE), by=Date]
DT[, gRoll_Deaths := sum(roll_Deaths, na.rm=TRUE), by=Date]
DT[, gMortality := gTotal_Deaths / gTotal_Cases]

# Rates of daily change
DT[, roll_Cases_Rate := frollapply(roll_Cases, n=2, FUN = function(x){x[2] / x[1]}, align="right"), by=Country]
DT[, roll_Deaths_Rate := frollapply(roll_Deaths, n=2, FUN = function(x){x[2] / x[1]}, align="right"), by=Country]
DT[, gRoll_Cases_Rate := frollapply(gRoll_Cases, n=2, FUN = function(x){x[2] / x[1]}, align="right"), by=Country]
DT[, gRoll_Deaths_Rate := frollapply(gRoll_Deaths, n=2, FUN = function(x){x[2] / x[1]}, align="right"), by=Country]

# Compare severity to one country.
homecountry = 'Austria'

The Covid10 dataset from ECDC comes without geospacial data. The geospacial data available from other sources may not be the most up-to-date with recognised countries and names.

message(paste(sum(!( world_spdf$ISO2 %in% DT$geoId | world_spdf$ISO3 %in% DT$countryCode)), 
                            "countries in the map file do not correspond to an entry in the Covid19 data."))
## 41 countries in the map file do not correspond to an entry in the Covid19 data.
outgroup <- unique(DT[!(geoId %in% world_spdf$ISO2 | countryCode %in% world_spdf$ISO3), 
                                            .(Country, countryCode, geoId)])
message(paste(nrow(outgroup),
                            "countries in the Covid19 data do not correspond to an entity in the map file:"))
## 6 countries in the Covid19 data do not correspond to an entity in the map file:
print(outgroup)
##                                       Country countryCode    geoId
## 1:          Bonaire, Saint Eustatius and Saba         BES       BQ
## 2: Cases_on_an_international_conveyance_Japan             JPG11668
## 3:                                   Curaçao         CUW       CW
## 4:                                     Kosovo         XKX       XK
## 5:                               Sint_Maarten         SXM       SX
## 6:                                South_Sudan         SSD       SS

One of those entries corresponds to a ship, leaving only 5 Countries not represented in the map file. I think for a global overview map, the missing countries will not make a big difference.

Status

minpop=5e5
current <- max(DT$Date)

print( data.frame(DaysTracked = length(unique(DT$Date)),
                    CountriesTracked = length(unique(DT$Country)) ) )
##   DaysTracked CountriesTracked
## 1         298              211
print( data.frame( Global_Cases = sum(DT$new_Cases),
                    Global_Deaths = sum(DT$new_Deaths),
                    Global_Mortality = sum(DT$new_Deaths) / sum(DT$new_Cases) ) )
##   Global_Cases Global_Deaths Global_Mortality
## 1     41771932       1138780       0.02726185

Reported events since the beginning

Absolute

subDT1 <- merge(world_df, DT[past_Days==0, .(countryCode, continent, total_Cases)], by.x='id', by.y='countryCode')
setorder(subDT1, ord)

subDT2 <- merge(world_df, DT[past_Days==0, .(countryCode, continent, total_Deaths)], by.x='id', by.y='countryCode')
setorder(subDT2, ord)

p1 <-   ggplot(subDT1, aes(x=long, y=lat, group=group, fill=total_Cases)) +
        geom_polygon(colour='black', size=0.2) +
        scale_fill_gradient(high='darkred', low='white') +
        theme_void() +
        theme(panel.background = element_rect(fill='#BBDDFF'))

p2 <-   ggplot(subDT2, aes(x=long, y=lat, group=group, fill=total_Deaths)) +
        geom_polygon(colour='black', size=0.2) +
        scale_fill_gradient(high='darkgreen', low='white') +
        theme_void() +
        theme(panel.background = element_rect(fill='#BBDDFF'))

print( p1 )

print( p2 )

p1 <-   ggplot(subDT1[continent=='Europe',], aes(x=long, y=lat, group=group, fill=total_Cases)) +
        geom_polygon(colour='black', size=0.2) +
        scale_fill_gradient(high='darkred', low='white') +
      coord_cartesian(xlim=c(-10, 50), ylim=c(30,70)) +
        theme_void() +
        theme(panel.background = element_rect(fill='#BBDDFF'))

p2 <-   ggplot(subDT2[continent=='Europe',], aes(x=long, y=lat, group=group, fill=total_Deaths)) +
        geom_polygon(colour='black', size=0.2) +
        scale_fill_gradient(high='darkgreen', low='white') +
      coord_cartesian(xlim=c(-10, 50), ylim=c(30,70)) +
        theme_void() +
        theme(panel.background = element_rect(fill='#BBDDFF'))


print( p1 )

print( p2 )

Normalized per 10^{6} residents.

subDT1 <- merge(world_df, DT[past_Days==0, .(countryCode, continent, norm_tot_Cases)], by.x='id', by.y='countryCode')
setorder(subDT1, ord)

subDT2 <- merge(world_df, DT[past_Days==0, .(countryCode, continent, norm_tot_Deaths)], by.x='id', by.y='countryCode')
setorder(subDT2, ord)

p1 <-   ggplot(subDT1, aes(x=long, y=lat, group=group, fill=norm_tot_Cases)) +
        geom_polygon(colour='black', size=0.2) +
        scale_fill_gradient(high='darkred', low='white') +
        theme_void() +
        theme(panel.background = element_rect(fill='#BBDDFF'))

p2 <-   ggplot(subDT2, aes(x=long, y=lat, group=group, fill=norm_tot_Deaths)) +
        geom_polygon(colour='black', size=0.2) +
        scale_fill_gradient(high='darkgreen', low='white') +
        theme_void() +
        theme(panel.background = element_rect(fill='#BBDDFF'))

print( p1 )

print( p2 )

p1 <-   ggplot(subDT1[continent=='Europe',], aes(x=long, y=lat, group=group, fill=norm_tot_Cases)) +
        geom_polygon(colour='black', size=0.2) +
        scale_fill_gradient(high='darkred', low='white') +
      coord_cartesian(xlim=c(-10, 50), ylim=c(30,70)) +
        theme_void() +
        theme(panel.background = element_rect(fill='#BBDDFF'))

p2 <-   ggplot(subDT2[continent=='Europe',], aes(x=long, y=lat, group=group, fill=norm_tot_Deaths)) +
        geom_polygon(colour='black', size=0.2) +
        scale_fill_gradient(high='darkgreen', low='white') +
      coord_cartesian(xlim=c(-10, 50), ylim=c(30,70)) +
        theme_void() +
        theme(panel.background = element_rect(fill='#BBDDFF'))


print( p1 )

print( p2 )

Reported events in last 7 days

Absolute

subDT1 <- merge(world_df, DT[past_Days==0, .(countryCode, continent, roll_Cases)], by.x='id', by.y='countryCode')
setorder(subDT1, ord)

subDT2 <- merge(world_df, DT[past_Days==0, .(countryCode, continent, roll_Deaths)], by.x='id', by.y='countryCode')
setorder(subDT2, ord)

p1 <-   ggplot(subDT1, aes(x=long, y=lat, group=group, fill=roll_Cases)) +
        geom_polygon(colour='black', size=0.2) +
        scale_fill_gradient(high='darkred', low='white') +
        theme_void() +
        theme(panel.background = element_rect(fill='#BBDDFF'))

p2 <-   ggplot(subDT2, aes(x=long, y=lat, group=group, fill=roll_Deaths)) +
        geom_polygon(colour='black', size=0.2) +
        scale_fill_gradient(high='darkgreen', low='white') +
        theme_void() +
        theme(panel.background = element_rect(fill='#BBDDFF'))

print( p1 )

print( p2 )

p1 <-   ggplot(subDT1[continent=='Europe',], aes(x=long, y=lat, group=group, fill=roll_Cases)) +
        geom_polygon(colour='black', size=0.2) +
        scale_fill_gradient(high='darkred', low='white') +
      coord_cartesian(xlim=c(-10, 50), ylim=c(30,70)) +
        theme_void() +
        theme(panel.background = element_rect(fill='#BBDDFF'))

p2 <-   ggplot(subDT2[continent=='Europe',], aes(x=long, y=lat, group=group, fill=roll_Deaths)) +
        geom_polygon(colour='black', size=0.2) +
        scale_fill_gradient(high='darkgreen', low='white') +
      coord_cartesian(xlim=c(-10, 50), ylim=c(30,70)) +
        theme_void() +
        theme(panel.background = element_rect(fill='#BBDDFF'))

print( p1 )

print( p2 )

Normalized per 10^{6} residents.

subDT1 <- merge(world_df, DT[past_Days==0, .(countryCode, continent, norm_roll_Cases)], by.x='id', by.y='countryCode')
setorder(subDT1, ord)

subDT2 <- merge(world_df, DT[past_Days==0, .(countryCode, continent, norm_roll_Deaths)], by.x='id', by.y='countryCode')
setorder(subDT2, ord)

p1 <-   ggplot(subDT1, aes(x=long, y=lat, group=group, fill=norm_roll_Cases)) +
        geom_polygon(colour='black', size=0.2) +
        scale_fill_gradient(high='darkred', low='white') +
        theme_void() +
        theme(panel.background = element_rect(fill='#BBDDFF'))

p2 <-   ggplot(subDT2, aes(x=long, y=lat, group=group, fill=norm_roll_Deaths)) +
        geom_polygon(colour='black', size=0.2) +
        scale_fill_gradient(high='darkgreen', low='white') +
        theme_void() +
        theme(panel.background = element_rect(fill='#BBDDFF'))

print( p1 )

print( p2 )

p1 <-   ggplot(subDT1[continent=='Europe',], aes(x=long, y=lat, group=group, fill=norm_roll_Cases)) +
        geom_polygon(colour='black', size=0.2) +
        scale_fill_gradient(high='darkred', low='white') +
      coord_cartesian(xlim=c(-10, 50), ylim=c(30,70)) +
        theme_void() +
        theme(panel.background = element_rect(fill='#BBDDFF'))

p2 <-   ggplot(subDT2[continent=='Europe',], aes(x=long, y=lat, group=group, fill=norm_roll_Deaths)) +
        geom_polygon(colour='black', size=0.2) +
        scale_fill_gradient(high='darkgreen', low='white') +
      coord_cartesian(xlim=c(-10, 50), ylim=c(30,70)) +
        theme_void() +
        theme(panel.background = element_rect(fill='#BBDDFF'))

print( p1 )

print( p2 )

Rate of change since the day before.

This looks at how the 7-day rolling totals changed from yesterday to today.

subDT1 <- merge(world_df, DT[past_Days==0, .(countryCode, continent, roll_Cases_Rate)], by.x='id', by.y='countryCode')
setorder(subDT1, ord)

subDT2 <- merge(world_df, DT[past_Days==0, .(countryCode, continent, roll_Deaths_Rate)], by.x='id', by.y='countryCode')
setorder(subDT2, ord)

p1 <-   ggplot(subDT1, aes(x=long, y=lat, group=group, fill=roll_Cases_Rate)) +
        geom_polygon(colour='black', size=0.2) +
        scale_fill_gradient(high='darkred', low='white') +
        theme_void() +
        theme(panel.background = element_rect(fill='#BBDDFF'))

p2 <-   ggplot(subDT2, aes(x=long, y=lat, group=group, fill=roll_Deaths_Rate)) +
        geom_polygon(colour='black', size=0.2) +
        scale_fill_gradient(high='darkgreen', low='white') +
        theme_void() +
        theme(panel.background = element_rect(fill='#BBDDFF'))

print( p1 )

print( p2 )

p1 <-   ggplot(subDT1[continent=='Europe',], aes(x=long, y=lat, group=group, fill=roll_Cases_Rate)) +
        geom_polygon(colour='black', size=0.2) +
        scale_fill_gradient(high='darkred', low='white') +
      coord_cartesian(xlim=c(-10, 50), ylim=c(30,70)) +
        theme_void() +
        theme(panel.background = element_rect(fill='#BBDDFF'))

p2 <-   ggplot(subDT2[continent=='Europe',], aes(x=long, y=lat, group=group, fill=roll_Deaths_Rate)) +
        geom_polygon(colour='black', size=0.2) +
        scale_fill_gradient(high='darkgreen', low='white') +
      coord_cartesian(xlim=c(-10, 50), ylim=c(30,70)) +
        theme_void() +
        theme(panel.background = element_rect(fill='#BBDDFF'))

print( p1 )

print( p2 )

Countries of personal interest

topInterest <- c('Austria', 'Italy', 'Greece', 'Luxembourg', 'Germany')
setorder(DT, Country, past_Days)

Normalized to 10^{6} residents.

In last 7 days

DT[past_Days==0 & Country %in% topInterest, .(Country, norm_roll_Cases, roll_Cases, norm_roll_Deaths, roll_Deaths)]
##       Country norm_roll_Cases roll_Cases norm_roll_Deaths roll_Deaths
## 1:    Austria       1419.4965      12575         7.111593          63
## 2:    Germany        659.2932      54734         2.649989         220
## 3:     Greece        398.0568       4269         6.247320          67
## 4:      Italy       1393.7149      84124         9.874163         596
## 5: Luxembourg       3402.8676       2089        11.402620           7

Since the beginning

DT[past_Days==0 & Country %in% topInterest, .(Country, norm_tot_Cases, total_Cases, norm_tot_Deaths, total_Deaths)]
##       Country norm_tot_Cases total_Cases norm_tot_Deaths total_Deaths
## 1:    Austria       8278.684       73339       108.02848          957
## 2:    Germany       4857.803      403291       119.89996         9954
## 3:     Greece       2630.961       28216        51.19073          549
## 4:      Italy       7715.863      465726       612.46319        36968
## 5: Luxembourg      20089.787       12333       228.05240          140

Timeline

case_col = '#FF0000'
death_col = '#0088FF'
homecountry = 'Austria'

# Numbers over time
tidyDT <- melt(DT[, .(Date, Country, norm_new_Cases, norm_new_Deaths, norm_tot_Cases, norm_tot_Deaths, norm_roll_Cases, norm_roll_Deaths)],
                                id.vars = c('Date', 'Country'), variable.name = 'Type', value.name = 'Normalized_count')
tidyDT[grepl('Death', Type), vsplit := 'Deaths']
tidyDT[!grepl('Death', Type), vsplit := 'Cases']
tidyDT[, hsplit := sub('_Cases|_Deaths', '', sub('norm_', '', Type), perl=TRUE)]
setkey(tidyDT, Country)

# Rolling VS Total (exponential-ness)
expDT <- DT[, .(Date, Country, norm_tot_Cases, norm_tot_Deaths, norm_roll_Cases, norm_roll_Deaths)]
tmptot <- melt(expDT, id.vars = c('Date', 'Country'), measure.vars = c('norm_tot_Cases', 'norm_tot_Deaths'), variable.name = 'Type', value.name = 'norm_Total')
tmptot[grepl('Death', Type), vsplit := 'Deaths']
tmptot[!grepl('Death', Type), vsplit := 'Cases']
tmproll <- melt(expDT, id.vars = c('Date', 'Country'), measure.vars = c('norm_roll_Cases', 'norm_roll_Deaths'), variable.name = 'Type', value.name = 'norm_Roll')
tmproll[grepl('Death', Type), vsplit := 'Deaths']
tmproll[!grepl('Death', Type), vsplit := 'Cases']
expDT <- merge(tmproll, tmptot, by=c('Date','Country', 'vsplit'))
setkey(expDT, Country)

# Rate of change
rateDT <- DT[, .(Date, Country, roll_Cases_Rate, roll_Deaths_Rate)]
rateDT <- melt(rateDT, id.vars = c('Date', 'Country'), value.name = 'daily_Rate', variable.name = 'Type')
rateDT[grepl('Death', Type), vsplit := 'Deaths']
rateDT[!grepl('Death', Type), vsplit := 'Cases']
setkey(rateDT, Country)



# Plot styles
relative_plot <- function(df=expDT, sel_country, title='') {
  ggplot(df, aes(x=norm_Total, y=norm_Roll, group=Country, colour=vsplit)) +
      facet_grid(vsplit ~ ., scales='free_y') +
        geom_line(colour='black', alpha=0.1, size=0.2) +
        geom_line(data=df[sel_country,], size=0.8) +
        scale_x_log10() +
        scale_y_log10() +
        scale_colour_manual(values=c(Deaths=death_col, Cases=case_col)) +
        coord_cartesian(xlim=c(1,NA), ylim=c(1,NA)) +
        annotation_logticks(sides='lrbt') +
        labs(title=title) +
        theme_bw() +
    theme(panel.grid=element_blank(),
          legend.position = 'none')
}
numbers_plot <- function(df=tidyDT, sel_country, title='') {
  ggplot(df, aes(x=Date, y=Normalized_count, group=Country, colour=vsplit)) +
        facet_grid(vsplit ~ hsplit, scales = 'free_y') +
        geom_line(colour='#000000', alpha=0.1, size=0.2) +
        geom_line(data=df[sel_country,], size=0.8) +
        scale_y_log10() +
        scale_colour_manual(values=c(Deaths=death_col, Cases=case_col)) +
        coord_cartesian(ylim=c(1,NA)) +
        annotation_logticks(sides='lr') +
        labs(title=title, y='', x='') +
        theme_bw() + 
        theme(legend.position = 'none',
                    panel.grid = element_blank())
}
rate_plot <- function(df=rateDT, sel_country, title='', D=W) {
    ggplot(df, aes(x=Date, y=daily_Rate, group=Country, colour=vsplit)) +
    facet_grid(vsplit ~ ., scales='free_y') +
        geom_hline(yintercept = 1, size=0.2) +
      geom_point(data=df[sel_country,], size=0.5) +
        geom_smooth(data=df[sel_country,], span=0.3, size=0.8) +
        scale_colour_manual(values=c(Deaths=death_col, Cases=case_col)) +
        coord_cartesian(ylim=c(0.6, 1.5)) +
        labs(title=title, x='', y='change_Ratio') +
        theme_bw() +
    theme(legend.position = 'none')
}
ratio_plot <- function(df=tidyDT, sel_country, ref_country=homecountry, title='') {
  ratioDT <- merge(df[sel_country], df[ref_country,], by=c('Date', 'Type'))
  ratioDT[, relative := Normalized_count.x / Normalized_count.y]
  ggplot(ratioDT[hsplit.y=='roll',], aes(x=Date, y=relative, colour=vsplit.y)) +
        facet_grid(vsplit.y ~ hsplit.y, scales = 'free_y') +
        geom_hline(yintercept = 1, size=0.15) +
        geom_point(size=0.5) +
      geom_smooth(span=0.3, size=0.75) +
        scale_y_continuous(trans='log2', breaks=c(1/32,1/16,1/8,1/4,1/2,1,4,8,16,32)) +
        scale_colour_manual(values=c(Deaths=death_col, Cases=case_col)) +
        coord_cartesian(ylim=c(1/33, 33)) +
        # annotation_logticks(sides='lr') +
        labs(title=title, y='', x='') +
        theme_bw() + 
        theme(legend.position = 'none',
                    axis.text.y.left = element_text())
}



# Plot collections
more_plots <- function(numbers=tidyDT, exponential=expDT, rates=rateDT, sel_country, ref_country=homecountry){

  cat(sel_country)
  p1 <- relative_plot(exponential, sel_country, 
                      title=paste(sel_country, ': ', W, '-day rolling sum, per', P/1e6, 'M residents, as function of total'))
    p2 <- numbers_plot(numbers, sel_country, 
                       title=paste(sel_country, ': new, total &', W, '-day rolling sum, normalized to', P/1e6, 'M residents'))
    p3 <- rate_plot(rates, sel_country,
                    title=paste(sel_country, ': Daily change rate of', W, '-day roll. sum'))
    p4 <- ratio_plot(numbers, sel_country, ref_country,
                     title=paste(sel_country,':', W, '-day norm.roll. sum, relative to', ref_country))
    
    print( p1 / p2 / p3 / p4 )
}

fewer_plots <- function(numbers=tidyDT[hsplit=='roll',], exponential=expDT, rates=rateDT, sel_country, ref_country=homecountry){

  cat(sel_country)
  p1 <- relative_plot(exponential, sel_country, 
                      title=paste(sel_country, ': ', W, '-day rolling sum, per', P/1e6, 'M residents, as function of total'))
    p2 <- numbers_plot(numbers, sel_country, 
                       title=paste(sel_country, ': new, total &', W, '-day rolling sum, normalized to', P/1e6, 'M residents'))
    p3 <- rate_plot(rates, sel_country,
                    title=paste(sel_country, ': Daily change rate of', W, '-day roll. sum'))
    
    print( p1 / p2 / p3 )
}

Global

subDT <- melt(unique(DT[, .(Date, gNew_Cases, gNew_Deaths, gTotal_Cases, gTotal_Deaths, gRoll_Cases, gRoll_Deaths)]),
                            id.vars="Date", variable.name="Type", value.name="Events")

p1 <- ggplot(subDT, aes(x=Date, y=Events, colour=Type, fill=Type)) +
    facet_grid( sub('^g', '', sub('_Cases', '', sub('_Deaths', '', subDT$Type))) ~ ., scales = 'free_y') +
    geom_line() +
    theme_minimal() + 
    labs(x='', y='') +
    theme(legend.position='none')

p2 <- ggplot(subDT, aes(x=Date, y=Events, colour=Type, fill=Type)) +
    facet_grid( sub('^g', '', sub('_Cases', '', sub('_Deaths', '', subDT$Type))) ~ ., scales = 'free_y') +
    geom_line() +
    scale_y_log10() +
    labs(x='', y='') +
    theme_minimal()

print( p1 + p2 )

subDT <- unique(DT[, .(Date, gRoll_Cases_Rate, gRoll_Deaths_Rate, gMortality)])

p3 <- ggplot(subDT, aes(x=Date, y=gRoll_Cases_Rate)) +
    geom_hline(yintercept = 1, size=0.1) +
    geom_line(colour=case_col, size=0.5) +
    coord_cartesian(ylim=c(0.9, 1.1)) +
    labs(title=paste('Daily change rate of ', W, '-day rolling sum')) +
    theme_bw()

p4 <- ggplot(subDT, aes(x=Date, y=gRoll_Deaths_Rate)) +
    geom_hline(yintercept = 1, size=0.1) +
    geom_line(colour=death_col, size=0.5) +
    coord_cartesian(ylim=c(0.9, 1.1)) +
    labs(title='') +
        theme_bw()

p5 <- ggplot(subDT, aes(x=Date, y=gMortality)) +
    geom_hline(yintercept = 0, size=0.1) +
    geom_line(colour=death_col, size=0.5) +
    labs(title='') +
        theme_bw()

print( p3 / p4 / p5)

Countries of personal interest

More

for (i in topInterest) {
    more_plots(tidyDT, expDT, rateDT, i, homecountry)
}
## Austria
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## Italy
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## Greece
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## Luxembourg
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## Germany
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

Less

for (i in topInterest) {
    fewer_plots(tidyDT[hsplit=='roll',], expDT, rateDT, i, homecountry)
}
## Austria
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## Italy
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## Greece
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## Luxembourg
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## Germany
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

Neighbours

for (i in c('Switzerland', 'Slovakia', 'Slovenia', 'Czechia', 'Hungary') ) {
    fewer_plots(tidyDT[hsplit=='roll',], expDT, rateDT, i, homecountry)
}
## Switzerland
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## Slovakia
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## Slovenia
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## Czechia
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## Hungary
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

Others

for (i in c('United_Kingdom', 'Spain', 'France', 'Belgium', 'United_States_of_America', 'Sweden', 'South_Korea') ) {
    fewer_plots(tidyDT[hsplit=='roll',], expDT, rateDT, i, homecountry)
}
## United_Kingdom
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## Spain
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## France
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## Belgium
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## United_States_of_America
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## Sweden
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## South_Korea
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

Session

sessionInfo()
## R version 4.0.3 (2020-10-10)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 18363)
## 
## Matrix products: default
## 
## locale:
## [1] LC_COLLATE=English_United Kingdom.1252 
## [2] LC_CTYPE=English_United Kingdom.1252   
## [3] LC_MONETARY=English_United Kingdom.1252
## [4] LC_NUMERIC=C                           
## [5] LC_TIME=English_United Kingdom.1252    
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] rgeos_0.5-5       maptools_1.0-2    rgdal_1.5-18      sp_1.4-4         
##  [5] broom_0.7.2       data.table_1.13.0 patchwork_1.0.1   ggrepel_0.8.2    
##  [9] ggplot2_3.3.2     lubridate_1.7.9   httr_1.4.2       
## 
## loaded via a namespace (and not attached):
##  [1] Rcpp_1.0.5       pillar_1.4.6     compiler_4.0.3   tools_4.0.3     
##  [5] digest_0.6.25    nlme_3.1-149     lattice_0.20-41  evaluate_0.14   
##  [9] lifecycle_0.2.0  tibble_3.0.4     gtable_0.3.0     mgcv_1.8-33     
## [13] pkgconfig_2.0.3  rlang_0.4.8      Matrix_1.2-18    curl_4.3        
## [17] yaml_2.2.1       xfun_0.18        withr_2.3.0      stringr_1.4.0   
## [21] dplyr_1.0.2      knitr_1.30       generics_0.0.2   vctrs_0.3.4     
## [25] grid_4.0.3       tidyselect_1.1.0 glue_1.4.2       R6_2.4.1        
## [29] foreign_0.8-80   rmarkdown_2.5    farver_2.0.3     purrr_0.3.4     
## [33] tidyr_1.1.2      magrittr_1.5     splines_4.0.3    backports_1.1.10
## [37] scales_1.1.1     ellipsis_0.3.1   htmltools_0.5.0  colorspace_1.4-1
## [41] labeling_0.4.2   stringi_1.5.3    munsell_0.5.0    crayon_1.3.4